Skadron Prize 2013 in Computational Physics
  “Longest tiles game”

The goal: Write a Mathematica module that places 50 blue tiles on a checker board with 10×10 squares with the goal to create the longest horizontal or vertical group of connected blue tiles. The only problem is that after you have placed your first tile, it is the other player’s turn to put a red tile down with the same goal of creating a longest horizontal or vertical line of red tiles.  Then it is your turn again and so on until all the 100 available squares are covered.  At the end, the player with the longest group of connected tiles (an integer L between 1 and 10) wins the game.  

Rules:  (1) If (by mistake) you try to place your blue tile on a square that is already covered, or you choose an invalid position, then a random location (possibly already occupied with a tile) will become red automatically, as a penalty for not paying attention. 
(2) In case of a tie, the player with the higher number of these (longest) tiles wins.  In case both players have the same number of longest tiles, the next smaller tile group will be considered. 

The code:  Email a request for the actual tournament code to grobe@ilstu.edu and you can then easily modify the module  “MyName1” to implement your algorithm.  An “Opponent” module is also provided, but for practice you can modify it as well. You can immediately run the complete code by typing  “⌘a”  (to select all Mathematica cells) and then ⇧⏎ (or ⌤ to run all cells).  At the end, I only need from you a single module that produces two integers (1≤x≤10 and 1≤y≤10) as your output variables at each turn.  In its truly dumbest form, it could look like this: 

MyName1:=Module[{x,y},
x=RandomInteger[{1,10}];
y=RandomInteger[{1,10}];
{x,y}] 

It is recommended to replace the second and third line (where the new position (x,y) for your blue tile is determined) with a slightly smarter version that should at least check before each move if a specific location (x,y) on the board is actually unoccupied.  A 10×10 matrix called “Board” tells you the present status of all tiles that have been placed on the board so far. If B(x,y) = 1 ⟹ location (x,y) is occupied with blue, if B(x,y) = – 1 ⟹ (x,y) is occupied with red, if B(x,y) = 0 ⟹ (x,y) is unoccupied.  Use the matrix “Board” to decide at which new location (x,y) you want to place your next blue tile.  A module that puts a tile only on unoccupied squares could look like this: 

MyName2:=Module[{x,y,i,j},
Do[ If [Board[[i,j]]==0, x=i;y=j] , {i,1,10},{j,1,10}];
{x,y}]

Deadline: Please email your Mathematica module called ”MyName1”  as an attachment to  grobe@ilstu.edu    by noon Wednesday, April 17th. 

Prize: The winner (or winning team) will be announced at our annual Physics Banquet (Bone Center Circus room on April 23th at 11am) and receive a check for $200.  The second prize will be $100. For a list of the winners since 1998, see www.phy.ilstu.edu/awards_and_prizes/skadron/index.shtml#skaprize.

Clear["Global`*"];Print["Begin at ", DateString[]];Beginminutes=SessionTime[];

Modules of the blue (=you) and red (opponent) player

MyName1:=Module[{x,y,i,j},
Do[If[Board[[i,j]]==0,x=i;y=j],{i,1,max},{j,1,max}];
{x,y}]

Opponent:=Module[{x,y},
x1=RandomSample[Range[10]];
y1=RandomSample[Range[10]];
Do[If[Board[[x1[[i]],j]]==0,x=x1[[i]];y=j];
If[Board[[i,y1[[j]]]]==0,x=i;y=y1[[j]]],{i,1,10},{j,1,10}];
{x,y}]

Running the competition  (no need to be modified)

Important:  Please do not change anything in the code below: It will perform the competetion using your module and then graph the game as it evolves, and then finally determines the winnner. 
There is no need to even look at this part of the program.

max=10;
Board=Table[0,{n,1,max},{m,1,max}];
BoardT=Table[Board,{t,100000}];
t=0;

While[  Product[Board[[i,j]],{i,max},{j,max}]==0,

tobechanged={Board,max}; Move=MyName1;
If[tobechanged≠{Board,max},Board=tobechanged[[1]];max=tobechanged[[2]];Speak["Cheater"]];

If[Board[[Move[[1]],Move[[2]]]]==0&&
Move[[1]] ∈ Integers&&0<Move[[1]]&&Move[[1]]<max+1&&
Move[[2]] ∈ Integers&&0<Move[[2]]&&Move[[2]]<max+1,Board[[Move[[1]],Move[[2]]]]=1,Board[[RandomInteger[{1,max}],RandomInteger[{1,max}]]]=-1];

t=t+1;
BoardT[[t]]=Board; 

If[ Product[Board[[i,j]],{i,max},{j,max}]==0,
Board=-Board;

tobechanged={Board,max}; Move=Opponent;
If[tobechanged≠{Board,max},Board=tobechanged[[1]];max=tobechanged[[2]];Speak["Cheater"]];

If[Board[[Move[[1]],Move[[2]]]]==0&&
Move[[1]] ∈ Integers&&0<Move[[1]]&&Move[[1]]<max+1&&
Move[[2]] ∈ Integers&&0<Move[[2]]&&Move[[2]]<max+1,Board[[Move[[1]],Move[[2]]]]=1,Board[[RandomInteger[{1,max}],RandomInteger[{1,max}]]]=-1];
Board=-Board;
t=t+1;
BoardT[[t]]=Board]
 ]

Determining the color of the longest  group of tiles (no need to be modified)

BBoard=Table[If[Board[[i,j]]==1,1,0],{i,max},{j,max}];
BWurstX=Table[0,{n,1,max},{m,1,max}];
Do[If[BBoard[[i,j]]==1,BWurstX[[i,j]]=1,BWurstX[[i,j]]=0],{i,1,max},{j,1,max}];
Do[If[BWurstX[[i,j]]==1,BWurstX[[i,j]]=BWurstX[[i,j-1]]+1,BWurstX[[i,j]]=0],{i,1,max},{j,2,max}];
BWurstY=Table[0,{n,1,max},{m,1,max}];
Do[If[BBoard[[i,j]]==1,BWurstY[[i,j]]=1,BWurstY[[i,j]]=0],{i,1,max},{j,1,max}];
Do[If[BWurstY[[i,j]]==1,BWurstY[[i,j]]=BWurstY[[i-1,j]]+1,BWurstY[[i,j]]=0],{i,2,max},{j,1,max}];

BWurst=Flatten[Append[Flatten[BWurstX],Flatten[BWurstY]]];

(*clean up the counting sausage that that  AnzahlB[[3]]= number of sausages with length 8  *)
BLength=Sort[BWurst,Greater];
AnzahlB=Table[0,{z,1,10}];AnzahlauxB=Table[0,{z,1,10}];  
Do[AnzahlauxB[[z]]=Count[BLength,11-z],{z,1,10}];
Do[AnzahlB[[z]]=AnzahlauxB[[z]]-AnzahlauxB[[z-1]],{z,2,10}];
AnzahlB[[1]]=AnzahlauxB[[1]];

RBoard=Table[If[Board[[i,j]]==-1,1,0],{i,max},{j,max}];
RWurstX=Table[0,{n,1,max},{m,1,max}];
Do[If[RBoard[[i,j]]==1,RWurstX[[i,j]]=1,RWurstX[[i,j]]=0],{i,1,max},{j,1,max}];
Do[If[RWurstX[[i,j]]==1,RWurstX[[i,j]]=RWurstX[[i,j-1]]+1,RWurstX[[i,j]]=0],{i,1,max},{j,2,max}];
RWurstY=Table[0,{n,1,max},{m,1,max}];
Do[If[RBoard[[i,j]]==1,RWurstY[[i,j]]=1,RWurstY[[i,j]]=0],{i,1,max},{j,1,max}];
Do[If[RWurstY[[i,j]]==1,RWurstY[[i,j]]=RWurstY[[i-1,j]]+1,RWurstY[[i,j]]=0],{i,2,max},{j,1,max}];

RWurst=Flatten[Append[Flatten[RWurstX],Flatten[RWurstY]]];

(*clean up the counting sausage that that  AnzahlB[[3]]= number of sausages with length 8  *)
RLength=Sort[RWurst,Greater];
AnzahlR=Table[0,{z,1,10}];AnzahlauxR=Table[0,{z,1,10}];  
Do[AnzahlauxR[[z]]=Count[RLength,11-z],{z,1,10}];
Do[AnzahlR[[z]]=AnzahlauxR[[z]]-AnzahlauxR[[z-1]],{z,2,10}];
AnzahlR[[1]]=AnzahlauxR[[1]];

(* now the cleaning is done *)

Print[Style["Final Analysis: ",18,Orange]]
Print["There were ",Count[Board,1,2]," blue tiles and ",Count[Board,-1,2]," tiles on the board"]

Grid[{{"     ","number of lines with length 10","# of L=9 lines "," L=8 "," L=7 ","L=6","L=5","L=4","L=3","L=2"},{"YOU",AnzahlB[[1]],AnzahlB[[2]],AnzahlB[[3]],AnzahlB[[4]],AnzahlB[[5]],AnzahlB[[6]],AnzahlB[[7]],AnzahlB[[8]],AnzahlB[[9]]},{"red",AnzahlR[[1]],AnzahlR[[2]],AnzahlR[[3]],AnzahlR[[4]],AnzahlR[[5]],AnzahlR[[6]],AnzahlR[[7]],AnzahlR[[8]],AnzahlR[[9]]}},Frame->All]

B= Sort[Flatten[BWurst],Greater];
R= Sort[Flatten[RWurst],Greater];
n=1;If[B==R,Speak["It is a Tie"],While[B[[n]]==R[[n]],n++];
If[B[[n]]>R[[n]], Speak["You have won"], Speak["Winner is Red"]]]
n=1;If[B==R,Print["It is a Tie"],While[B[[n]]==R[[n]],n++];
If[B[[n]]>R[[n]],Print["The winner is blue"], Print["Winner is Red"]]]

Animate[
MatrixPlot[-BoardT[[n]],BaseStyle->{10,FontFamily->"Times"},ColorFunction->(ColorData["TemperatureMap"])],{n,1,t,1},AnimationRepetitions->1]

Print["End at ",DateString[]," after ",(SessionTime[]-Beginminutes)/60 ," minutes"]